home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / os2 / adaptor.zip / ADAPT.ZIP / adaptor / examples / dalib / overlap / test3.f < prev    next >
Text File  |  1993-04-27  |  2KB  |  83 lines
  1.       program overlap_test
  2.  
  3.       parameter (n=30)
  4.  
  5.       real a(n, n, n)
  6.       call cmf_random (a)
  7.       call test_leftup1 (a,n)
  8.       call test_rightdown2 (a,n)
  9.       end
  10.  
  11.       subroutine test_leftup1 (a, n)
  12.  
  13.       integer n
  14.  
  15.       real a(n,n,n), b(n[1:0],n[1:0],n[1:0])
  16.       real a1(n,n,n)
  17.       logical equal (n,n,n)
  18.       integer errors
  19.  
  20. c     call print_a (a, n)
  21.  
  22.       b = a
  23.       forall (i=1:n,j=1:n,k=1:n)
  24.          a1 (k,j,i) = b (k-1,j-1,i-1)
  25.       end forall
  26. c     call print_a (a1, n)
  27.  
  28.  
  29.       a = cshift (a, 1, -1)
  30.       a = cshift (a, 2, -1)
  31.       a = cshift (a, 3, -1)
  32. c     call print_a (a, n)
  33.  
  34.       equal = (a1 .eq. a)
  35.       errors = count (equal)
  36.       errors = n*n*n - errors
  37.  
  38.       print *, errors, ' Errors for left overlapping'
  39.       end
  40.  
  41.       subroutine test_rightdown2 (a, n)
  42.  
  43.       integer n
  44.  
  45.       real a(n,n,n), b(n[0:2],n[0:3],n[0:1])   
  46.       real a1(n,n,n)
  47.       logical equal (n,n,n)
  48.       integer errors
  49.  
  50. c     call print_a (a, n)
  51.  
  52.       b = a
  53.       forall (i=1:n,j=1:n,k=1:n)
  54.          a1 (j,i,k) = b (j+2,i+3,k+1)
  55.       end forall
  56. c     call print_a (a1, n)
  57.  
  58.  
  59.       a = cshift (a, 1, 2)
  60.       a = cshift (a, 2, 3)
  61.       a = cshift (a, 3, 1)
  62. c     call print_a (a, n)
  63.  
  64.       equal = (a1 .eq. a)
  65.       errors = count (equal)
  66.       errors = n*n*n - errors
  67.  
  68.       print *, errors, ' Errors for right overlapping'
  69.       end
  70.  
  71.       subroutine print_a (a, n)
  72.       real a(n,n,n)
  73.       integer i, j, k, n
  74.       do i = 1, n
  75.        do j = 1, n
  76.          do k = 1, n
  77.             print *, 'a(',i,',',j,',',k,') = ', a(i,j,k)
  78.          end do
  79.        end do
  80.       end do
  81.       end
  82.  
  83.